home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / SLTPU70C / MENUDEF.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-08  |  6KB  |  225 lines
  1.  
  2. Unit MenuDef;
  3.  { Definitions & Code for Searchlight 2.25 file based menu system }
  4.  
  5.  { Definitions and code in this file are provided as-is and without
  6.    documentation for now. }
  7.  
  8. Interface
  9.  
  10.   Uses Filedef,Block,Users;
  11.  
  12.  
  13. type EntryType = (Internal,Door,Menu);
  14.      PauseType = (NoPause,Delay,KeyHit);
  15.      ExecType = (Display,Execute);
  16.      PromptOptionType  = (WordPrompt,SingleChar,MenuBar);
  17.  
  18.      MenuDefType = record
  19.        commands: integer;           { total # of commands on menu }
  20.        ExitCmd: boolean;            { no longer used }
  21.        ClearScreen: boolean;        { clear screen before displaying menu? }
  22.        DisplayFile: string[30];     { optional/external display file }
  23.        DisplayOption: array [Expert..Novice]
  24.          of Boolean;
  25.        PromptOption: array[Expert..Novice]
  26.          of PromptOptionType;
  27.        Prompt: array[1..3]
  28.          of string[40];
  29.        title: string[40];
  30.        displaytitle: boolean;
  31.        extra: string[49];           { pad to 256 bytes }
  32.      end;
  33.  
  34.      MenuItemType = record
  35.        name: string[15];            { menu item name }
  36.        key: char;                   { hotkey that executes item }
  37.        descrip: string[40];         { choice description }
  38.        p: pausetype;                { [not used] }
  39.        minaccess: integer;          { minimum access }
  40.        reqattrib: attribset;        { minimum attributes }
  41.        maxaccess: integer;          { maximum access }
  42.        exattrib: attribset;         { exclude attributes }
  43.        helplevels: byte;            { help levels that command supports, 0=All }
  44.        userpref: attribset;         { user preferences }
  45.  
  46.        extra: string[9];      { pad to 256 }
  47.  
  48.        case Entry: EntryType of
  49.          Internal: (
  50.            commands: array[1..4] of integer;
  51.            params: array[1..4] of string[30];
  52.            extra1: string[36]);
  53.          Door: (
  54.            d: AutoDoorType);
  55.          Menu: (
  56.            menuname: string[8];
  57.            command: ExecType);
  58.      end;
  59.  
  60.  
  61.      MenuItemArray = Array[1..1] of MenuItemType;
  62.      MenuItemPtr = ^MenuItemArray;
  63.  
  64.      MenuType = record             { Menu structure in RAM }
  65.        name: string[8];
  66.        size: integer;
  67.        data: MenuDefType;
  68.        items: MenuItemPtr;
  69.      end;
  70.  
  71.      AccessPtr = ^AccessType;
  72.  
  73.  Function ReadMenu (filename: string; var m: menutype): boolean;
  74.  Function WriteMenu (filename: string; var m: menutype): boolean;
  75. Procedure ScanMenu (var m: menutype; a: AccessPtr; h: helplevel;
  76.                     upref: attribset; system: integer);
  77. Procedure ClearMenu (var m: menutype);
  78. Procedure DisposeMenu (var m: menutype);
  79.  
  80. const MaxMenuSize = 64;
  81.  
  82. var Main: MenuType;        { Main, or currently active, menu }
  83.  
  84.  
  85. Implementation
  86.  
  87. var MenuFile: BlockFileType;
  88.  
  89.  
  90. Function ReadMenu (filename: string; var m: menutype): boolean;
  91.   { loads a menu from the menu directory into memory }
  92. var i: integer;
  93. Begin
  94.   assign(MenuFile.Filevar,cf.Menupath+filename+'.MNU');
  95.   if OpenBlockFile(MenuFile) then begin
  96.     m.name:=filename;
  97.     m.size:=0;
  98.     block_read(menufile.filevar,m.data,sizeof(fileheader),sizeof(m.data));
  99.     GetMem(m.items,sizeof(menuitemtype)*m.data.commands);
  100.     for i:=1 to m.data.commands do begin
  101.       inc(m.size);
  102.       ReadBlockFile(menufile,i,@m.items^[i]);
  103.     end;
  104.     CloseBlockFile(MenuFile);
  105.     ReadMenu:=true;
  106.   end
  107.   else ReadMenu:=false;
  108. end;
  109.  
  110.  
  111. Function WriteMenu (filename: string; var m: menutype): boolean;
  112.   { writes menu in memory back to disk (overwrites existing file) }
  113. var x: word;
  114. Begin
  115.   assign(MenuFile.Filevar,cf.Menupath+filename+'.MNU');
  116.   {$I-} erase(MenuFile.Filevar); {$I+}
  117.   x:=IOResult;
  118.  
  119.   assign(MenuFile.Filevar,cf.Menupath+filename+'.MNU');
  120.   with menufile do begin
  121.     recsize:=sizeof(menuitemtype);
  122.     offset:=sizeof(menudeftype);
  123.   end;
  124.   if CreateBlockFile(MenuFile,m.data.commands) then begin
  125.     block_write(menufile.filevar,m.data,sizeof(fileheader),sizeof(m.data));
  126.     for x:=1 to m.data.commands do
  127.       WriteBlockFile(menufile,x,@m.items^[x]);
  128.     m.name:=filename;
  129.     m.size:=m.data.commands;
  130.     CloseBlockFile(menufile);
  131.     WriteMenu:=true;
  132.   end
  133.   else WriteMenu:=false;
  134. end;
  135.  
  136.  
  137. Procedure ClearMenu (var m: menutype);
  138. Begin
  139.   fillchar(m,sizeof(m),0);
  140. end;
  141.  
  142. Procedure DisposeMenu (var m: menutype);
  143. Begin
  144.   if m.items<>Nil
  145.     then FreeMem(m.items,sizeof(menuitemtype)*m.data.commands);
  146.   ClearMenu(m);
  147. end;
  148.  
  149.  
  150.  
  151. Procedure ScanMenu (var m: menutype; a: AccessPtr; h: helplevel;
  152.                     upref: attribset; system: integer);
  153.  
  154.   { removes commands from menu which fail access level test }
  155.  
  156. const sysaccess: accesstype = (Attrib: [1..24]; MsgLevel: 255; FileLevel: 255);
  157.  
  158. var i,d: integer;
  159.     t: MenuItemPtr;
  160.  
  161.   Function HelpOK (var i: menuitemtype): Boolean;
  162.   Begin
  163.     case h of
  164.       Expert: HelpOK:=(i.helplevels in [0,3,5,6]);
  165.       Intermediate: HelpOK:=(i.helplevels in [0,2,4,6]);
  166.       Novice: HelpOK:=(i.helplevels in [0,1,4,5]);
  167.     end;
  168.   end;
  169.  
  170.   Function PrefOK (var i: menuitemtype): Boolean;
  171.   var n: integer;
  172.       result: boolean;
  173.   Begin
  174.     result:=(i.userpref=[]);
  175.     for n:=1 to 24 do
  176.       result:=result or ((n in i.userpref) and (n in upref));
  177.     PrefOK:=result;
  178.   end;
  179.  
  180.   Function Allow (var i: menuitemtype): boolean;
  181.   var ok: boolean;
  182.   Begin
  183.     case system of
  184.       1: begin  { Main/Message }
  185.         ok:=(i.minaccess<=a^.msglevel) and (i.reqattrib-a^.attrib=[]);
  186.         if ok then begin
  187.           if a^.msglevel>i.maxaccess
  188.             then ok:=false;
  189.           if (i.exattrib<>[]) and (i.exattrib-a^.attrib=[])
  190.             then ok:=false;
  191.         end;
  192.       end;
  193.  
  194.       2: begin  { Files }
  195.         ok:=(i.minaccess<=a^.filelevel) and (i.reqattrib-a^.attrib=[]);
  196.         if ok then begin
  197.           if a^.filelevel>i.maxaccess
  198.             then ok:=false;
  199.           if (i.exattrib<>[]) and (i.exattrib-a^.attrib=[])
  200.             then ok:=false;
  201.         end;
  202.       end;
  203.     end;
  204.     Allow:=Ok and HelpOK(i) and PrefOK(i);
  205.   end;
  206.  
  207. Begin
  208.   if cf.superuser then a:=@sysaccess;
  209.   d:=0;
  210.   for i:=1 to m.data.commands do begin
  211.     if not Allow(m.items^[i]) then begin
  212.       inc(d);
  213.       dec(m.size);
  214.     end else begin
  215.       if (d<>0)
  216.         then m.items^[i-d]:=m.items^[i];
  217.     end;
  218.   end;
  219.  
  220. end;
  221.  
  222.  
  223.  
  224. end.
  225.